home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amoszine 9
/
Amoszine 9 (Disk 3 of 3).adf
/
AJC_Source.lha
/
AJC-COSv1.AMOS
/
AJC-COSv1.amosSourceCode
next >
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
NeXTSTEP
RISC OS
UTF-8
Wrap
AMOS Source Code
|
1992-09-02
|
21.8 KB
|
1,182 lines
'
' Cos v1.0
'
' By Andrew Campbell 1995
'
' This is an interesting pattern generator-type program, coded in
' about three evenings. It uses various COS/SIN/TAN routines to draw
' complex patterns under user (vague) control - some of the techniques
' have been stolen and adapted from the AMOS PD CD collection.
'
' Control is via the mouse. Every pattern option can be TESTED or GENERATED
' in either COS, TAN, SIN or RND. Please COMPILE the program for maximum
' speed and remember this is the first, experimental version. Do NOT leave
' one pattern drawing forever whilst you go out with your mates and get
' rat arsed: your computer will undoubtedly crash. STOP each function with
' the mouse when you've got a nice suitable pattern.
'
' Toying around is the name of the game. Or rather, program. Ahem.
' Enjoy it - AJC
'
' Note from Andy Gibson. This requires the JD Extension. Please help
' me out guys when sending in source that uses Extensions by telling me
' which ones your code uses! :^) Cheers for now ....
Dim YTOPLINE(640),YBASELINE(640)
Dim X(100),Y(100)
Global CINV,CSCH,_MENUVISIBLE,_SELECTED,_FUNCTION,_TEST,C,X1,Y1
Global YTOPLINE(),YBASELINE()
Global X(),Y(),I
CINV=1
CSCH=3
_MENUVISIBLE=1
_SELECTED=1
_FUNCTION=1
_TEST=0
_SSPEED=9
_SETUP
Screen 1
Reserve Zone(30)
_SETZONES
RES:
Do
Screen 1
X=X Screen(X Mouse)
Y=Y Screen(X Mouse)
MZ=Mouse Zone
If Mouse Key=2 and _MENUVISIBLE=1
Screen Hide 1
Wait 10
_MENUVISIBLE=0
Goto NB
End If
If Mouse Key=2 and _MENUVISIBLE=0
Screen Show 1
Wait 10
_MENUVISIBLE=1
End If
NB:
If Mouse Key=1 and MZ>0
If MZ>0 and MZ<15 and _FUNCTION<>MZ
_SETFUNCTION[1]
_FUNCTION=MZ
_SETFUNCTION[0]
End If
If MZ>21 and MZ<26 and _SELECTED<>MZ-21
_SETSELECTED[1]
_SELECTED=MZ-21
_SETSELECTED[0]
End If
If MZ=15
Screen Copy 4 To 0
End If
If MZ=16
On Error Goto ER
F$=Fsel$("","","Load An IFF Picture")
If F$<>""
Screen 0
Load Iff F$
End If
Screen To Front 1
End If
If MZ=17
On Error Goto ER
F$=Fsel$("","","Save Image As IFF")
If F$<>""
Screen 0
Save Iff F$
End If
Screen To Front 1
End If
If MZ=18
Add CSCH,1
If CSCH>9 : CSCH=1 : End If
Screen 0
_SETPALETTE
Wait 10
End If
If MZ=19
Add CINV,1
If CINV>1 : CINV=0 : End If
Screen 0
_SETPALETTE
Wait 10
End If
If MZ=20
Screen Hide 1
Change Mouse 3
Wait 20
_TEST=1
_GENERATE
_TEST=0
Change Mouse 1
Screen Show 1
View
Wait 10
End If
If MZ=21
Screen Copy 0 To 4
Screen 0
Cls 15
Screen 1
End If
If MZ=26
Screen Hide 1
Change Mouse 3
Wait 20
_GENERATE
Change Mouse 1
Screen Show 1
View
Wait 10
End If
If MZ=27
Dec _SSPEED
If _SSPEED<1 : _SSPEED=1 : End If
Screen 0
Shift Up _SSPEED,1,15,1
Wait 10
End If
If MZ=28
_SSPEED=9
Screen 0
Shift Off
_SETPALETTE
Wait 10
End If
If MZ=29
Dec _SSPEED
If _SSPEED<1 : _SSPEED=1 : End If
Screen 0
Shift Down _SSPEED,1,15,1
Wait 10
End If
End If
Loop
ER:
Boom
Resume RES
Procedure _SETUP
Auto View Off
Unpack 10 To 4
Screen Hide 4
Screen Open 0,320,256,16,Lowres
Curs Off : Flash Off
_SETPALETTE
_SETPOINTER
Cls 15
Screen Open 1,640,96,8,Hires
Curs Off : Flash Off : Cls 0
Screen Copy 4,0,0,640,96 To 1,0,0
Get Palette 4
_SETPOINTER
_SETSELECTED[0]
_SETFUNCTION[0]
Screen Display 1,,201,,
Screen Open 4,320,256,16,Lowres
Curs Off : Flash Off
_SETPALETTE
_SETPOINTER
Cls 15
Screen Hide 4
Limit Mouse 129,43 To 449,291
Auto View On
View
End Proc
Procedure _SETPALETTE
If CSCH=1
_SETSPREAD[$111,$FFF]
End If
If CSCH=2
_SETSPREAD[$100,$F00]
End If
If CSCH=3
_SETSPREAD[$10,$F0]
End If
If CSCH=4
_SETSPREAD[$1,$F]
End If
If CSCH=5
_SETSPREAD[$11,$FF]
End If
If CSCH=6
_SETSPREAD[$101,$F0F]
End If
If CSCH=7
_SETSPREAD[$110,$FF0]
End If
If CSCH=8
_SETSPREAD[$101,$FF]
End If
If CSCH=9
_SETSPREAD[$10,$FF0]
End If
End Proc
Procedure _SETSPREAD[A,B]
If CINV=0
Colour 1,A
Colour 15,B
Else
Colour 1,B
Colour 15,A
End If
Extension_20_0006 1 To 15
End Proc
Procedure _SETPOINTER
For I=17 To 19 : Colour I,$F0 : Next I
End Proc
Procedure _SETSELECTED[OLD]
If OLD=1
Ink 4
Else
Ink 7
End If
If _SELECTED=1
Paint 528,26
End If
If _SELECTED=2
Paint 576,30
End If
If _SELECTED=3
Paint 540,48
End If
If _SELECTED=4
Paint 578,49
End If
End Proc
Procedure _SETFUNCTION[OLD]
If OLD=1
Ink 4
Else
Ink 7
End If
On _FUNCTION Gosub 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21
Pop Proc
1 Paint 50,27 : Return
2 Paint 96,24 : Return
3 Paint 178,32 : Return
4 Paint 230,30 : Return
5 Paint 300,30 : Return
6 Paint 370,25 : Return
7 Paint 410,27 : Return
8 Paint 26,46 : Return
9 Paint 110,51 : Return
10 Paint 178,51 : Return
11 Paint 229,48 : Return
12 Paint 299,49 : Return
13 Paint 374,47 : Return
14 Paint 426,47 : Return
15 Paint 40,77 : Return
16 Paint 116,73 : Return
17 Paint 170,77 : Return
18 Paint 236,77 : Return
19 Paint 294,77 : Return
20 Paint 370,77 : Return
21 Paint 442,74 : Return
End Proc
Procedure _SETZONES
Screen 1
Reserve Zone(30)
BB=0
For I=0 To 6
Set Zone I+1,16+BB+(48*I),22 To 64+BB+(48*I),38
Add BB,16
Next I
BB=0
For I=0 To 6
Set Zone 8+I,16+BB+(48*I),43 To 64+BB+(48*I),60
Add BB,16
Next I
BB=0
For I=0 To 6
Set Zone 15+I,16+BB+(48*I),64 To 64+BB+(48*I),81
Add BB,16
Next I
Set Zone 22,504,22 To 554,39
Set Zone 23,570,22 To 618,39
Set Zone 24,506,43 To 554,59
Set Zone 25,570,43 To 618,60
Set Zone 26,500,64 To 626,80
Set Zone 27,462,22 To 484,38
Set Zone 28,462,44 To 484,59
Set Zone 29,462,65 To 484,81
End Proc
Procedure _GENERATE
Screen Copy 0 To 4
If _FUNCTION=1 : _COSBLAST : End If
If _FUNCTION=2 : _CRISSCROSS : End If
If _FUNCTION=3 : _COOLCIRCLES : End If
If _FUNCTION=4 : _COOLPATTERN : End If
If _FUNCTION=5 : _HUGECIRCLE : End If
If _FUNCTION=6 : _SIDEPATTERN : End If
If _FUNCTION=7 : If _TEST=0 : _WAVY[10,1,3] Else _WAVY[10,4,3] : End If : End If
If _FUNCTION=8 : _SPIRAL : End If
If _FUNCTION=9 : _COOLSCAPE : End If
If _FUNCTION=10 : _COOLTHINGS : End If
If _FUNCTION=11 : _COOLTWISTER : End If
If _FUNCTION=12 : _COOLGRASS : End If
If _FUNCTION=13 : _COOLSPIRAL : End If
If _FUNCTION=14 : _COOLDOTS : End If
End Proc
Procedure _COSBLAST
Screen 0
Degree
X=0 : Y=0 : YYY=256 : XX=0 : DEG=1
Repeat
Inc DEG
If DEG>360 : DEG=1 : End If
Inc X
If X>319 : X=0 : Inc Y : Inc XX : Inc A : End If
If _SELECTED=1
YY#=Hcos(X)-Cos(X)
End If
If _SELECTED=2
YY#=Hcos(X)-Tan(X)
End If
If _SELECTED=3
YY#=Hcos(X)-Sin(X)
End If
If _SELECTED=4
YY#=Hcos(X)
End If
If _TEST=0
C=Point(X,Y+YY#*A)
If C=1 : C=2 : End If
Dec C
Else
C=1
End If
If C>-1
Extension_12_036E X,Y+YY#*A,C
End If
If _TEST=0
C=Point(XX,YYY-YY#*A)
If C=0 : C=1 : End If
Dec C
Else
C=1
End If
If C>-1
Extension_12_036E XX,YYY-YY#*A,C
End If
Until Mouse Key
End Proc
Procedure _CRISSCROSS
Screen 0
Degree
X=0 : Y=0 : DEG=1
Repeat
Inc DEG
If DEG>360 : DEG=1 : End If
Inc X
If X>319 : X=0 : Inc Y : End If
If _SELECTED=1
YY#=Cos(DEG)
End If
If _SELECTED=2
YY#=Tan(DEG)
End If
If _SELECTED=3
YY#=Sin(DEG)
End If
If _SELECTED=4
YY#=Hcos(DEG)
End If
If _TEST=0
C=Point(X,Y+YY#*X)
If C=1 : C=2 : End If
Ink C-1
Else
Ink 1
End If
Plot X,Y+YY#*X
Until Mouse Key
End Proc
Procedure _COOLPATTERN
Screen 0
Degree
X=0
Y=0
DEG=1
Repeat
Inc DEG
If DEG>360 : DEG=1 : End If
Inc X
If X>319 : X=0 : Inc Y : Inc A : End If
If _SELECTED=1
YY#=Cos(X)
End If
If _SELECTED=2
YY#=Tan(X)
End If
If _SELECTED=3
YY#=Sin(X)
End If
If _SELECTED=4
YY#=Hcos(X)
End If
If _TEST=0
C=Point(X,Y+YY#*A)
If C=1 : C=2 : End If
Dec C
Else
C=1
End If
If C>-1
Extension_12_036E X,Y+YY#*A,C
End If
Until Mouse Key
End Proc
Procedure _COOLCIRCLES
Screen 0
Radian
Repeat
HELL:
P=0
S=0
N#=0.0
X=Rnd(300)+15
Y=Rnd(240)+10
R=Rnd(1500)+200
For I=1 To R
If Mouse Key : Pop Proc : End If
N#=N#-0.039
P=P+150
S=S+1
If _TEST=0
If _SELECTED=1
C=Point(N#*Cos(P)+X,N#*Sin(P)+Y)
End If
If _SELECTED=2
C=Point(N#*Tan(P)+X,N#*Sin(P)+Y)
End If
If _SELECTED=3
C=Point(N#*Sin(P)+X,N#*Pi#+Y)
End If
If _SELECTED=4
C=Point(N#*Cos(P)+X,N#*Tan(P)+Y)
End If
If C=1 : C=2 : End If
Dec C
Else
C=1
End If
If C>-1
If _SELECTED=1
Plot N#*Cos(P)+X,N#*Sin(P)+Y,C
End If
If _SELECTED=2
Plot N#*Tan(P)+X,N#*Sin(P)+Y,C
End If
If _SELECTED=3
Plot N#*Sin(P)+X,N#*Pi#+Y,C
End If
If _SELECTED=4
Plot N#*Cos(P)+X,N#*Tan(P)+Y,C
End If
End If
If S=28
S=0
End If
Next I
Goto HELL
Until Mouse Key
End Proc
Procedure _HUGECIRCLE
Screen 0
Radian
N#=0.0
P=0
S=0
SA#=0.019
AAA=0
Repeat
N#=N#-SA#
P=P+15
S=S+1
If _TEST=0
If _SELECTED=1
C=Point(N#*Sin(P)+160,N#*Cos(P)+128)
End If
If _SELECTED=2
C=Point(N#*Tan(P)+160,N#*Cos(P)+128)
End If
If _SELECTED=3
C=Point(N#*Pi#+160,N#*Sin(P)+128)
End If
If _SELECTED=4
C=Point(N#*Sin(P)+160,N#*Tan(P)+128)
End If
If C=1 : C=2 : End If
Dec C
Else
C=1
End If
If C>-1
If _SELECTED=1
Extension_12_036E N#*Sin(P)+160,N#*Cos(P)+128,C
End If
If _SELECTED=2
Extension_12_036E N#*Tan(P)+160,N#*Cos(P)+128,C
End If
If _SELECTED=3
Extension_12_036E N#*Sin(P)+AAA,N#*Cos(P)+128,C
End If
If _SELECTED=4
Extension_12_036E N#*Sin(P)+160,N#*Tan(P)+128,C
End If
End If
If S=28
S=0
End If
Inc AAA
If AAA>320 : AAA=0 : End If
Until Mouse Key
End Proc
Procedure _SIDEPATTERN
Screen 0
Degree
A#=-360
X=0 : Y=20 : YYY=256 : XX=0 : DEG=1
Repeat
Inc DEG
If DEG>360 : DEG=1 : End If
Inc X
If X>319 : X=0 : Inc Y : Inc XX : A#=A#+Pi# : End If
If _SELECTED=1
YY#=Hcos(X)-Cos(X)
End If
If _SELECTED=2
YY#=Hsin(X)-Sin(X)
End If
If _SELECTED=3
YY#=Htan(X)-Tan(X)
End If
If _SELECTED=4
YY#=Htan(X)-Cos(X)
End If
If _TEST=0
C=Point(X,Y+YY#*A#)
If C=1 : C=2 : End If
Dec C
Else
C=1
End If
If C>0
Extension_12_036E X,Y+YY#*A#,C
End If
Until Mouse Key
End Proc
Procedure _WAVY[IN,STE,SPEED]
Degree
Screen 0
FF=0
Repeat
For X=0 To 320 Step STE
If Mouse Key : Pop Proc : End If
If _SELECTED=1
Y#=Cos(X+FF)*IN
End If
If _SELECTED=2
Y#=Tan(X+FF)*IN
End If
If _SELECTED=3
Y#=Sin(X+FF)*IN
End If
If _SELECTED=4
Y#=Hcos(X+FF)*IN
End If
Wait Vbl
Screen Copy 0,X,0,X+STE,256 To 0,X,Y#+10
Next X
Add FF,SPEED
Until Mouse Key
End Proc
Procedure _SPIRAL
Screen 0
Degree
For EFFECT=1 To 50
X=160
Y=128
X1=0
Y1=0
Screen 0
For T=1 To 20000
If Mouse Key : Pop Proc : End If
If _SELECTED=1
X1=X+T*Sin(T/EFFECT)/200
Y1=Y+T*Cos(T/50)/200
End If
If _SELECTED=2
X1=X+T*Tan(T/EFFECT)/200
Y1=Y+T*Cos(T/50)/200
End If
If _SELECTED=3
X1=X+T*Cos(T/EFFECT)/200
Y1=Y+T*Sin(T/50)/200
End If
If _SELECTED=4
X1=X+T*Tan(T/EFFECT)/200
Y1=Y+T*Hcos(T/50)/200
End If
If _TEST=0
C=Point(X1,Y1)
If C=1 : C=2 : End If
Dec C
Else
C=1
End If
If C>-1
Extension_12_036E X1,Y1,C
End If
Next T
Next EFFECT
End Proc
Procedure _COOLSCAPE
Screen 0
Radian
For I=1 To 639 : YBASELINE(I)=0 : Next I
For I=1 To 639 : YTOPLINE(I)=255 : Next I
XAXIS=320 : YAXIS=127
RHO#=80.0 : D#=750.0
THETA#=0.4 : S1#=Sin(THETA#) : C1#=Cos(THETA#)
PHI#=1.25 : S2#=Sin(PHI#) : C2#=Cos(PHI#)
If _SELECTED=1
Def Fn Z#(X#)=Cos(0.06*(X#*X#+Y#*Y#))
End If
If _SELECTED=2
Def Fn Z#(X#)=Sin(0.06*(X#*X#+Y#*Y#))
End If
If _SELECTED=3
Def Fn Z#(X#)=Tan(0.06*(X#*X#+Y#*Y#))
End If
If _SELECTED=4
Def Fn Z#(X#)=Cos(0.06*(X#*X#/Y#*Y#))
End If
For X#=22.0 To -55.0 Step -0.2
If Mouse Key : Pop Proc : End If
FL=0
For Y#=-40.0 To 19.0 Step 0.2
Z#= Fn Z#(X#)
Gosub PLTER
If Mouse Key : Pop Proc : End If
Next Y#
Next X#
PLTER:
XE#=(-X#*S1#+Y#*C1#)
YE#=(-X#*C1#*C2#-Y#*S1#*C2#+Z#*S2#)
ZE#=(-X#*S2#*C1#-Y#*S2#*S1#-Z#*C2#+RHO#)
SX=Int(D#*(XE#/ZE#)+XAXIS)
SY=Int(-D#*(YE#/ZE#)+YAXIS)
If FL=0
FL=1
F=0
Else
DX=OLDX-SX
If DX=0
DX=1
End If
SL=(OLDY-SY)/DX
YP=OLDY
For XP=Int(OLDX)+1 To SX
FG=1
YP=YP+SL
If(XP<0) or(XP>630)
FG=0
F=0
Goto LOP
End If
If(YP<0) or(YP>250)
FG=0
F=0
End If
If YP<=YTOPLINE(XP)
YTOPLINE(XP)=YP
If FG<>0
If F=0
Gosub MAG
Extension_12_036E XP,YP,C
F=1
End If
Gosub MAG
Extension_12_036E XP,YP,C
End If
If YP=>YBASELINE(XP)
YBASELINE(XP)=YP
If FG=0
Goto LOP
End If
If F=0
F=1
Gosub MAG
Extension_12_036E XP,YP,C
End If
Gosub MAG
Extension_12_036E XP,YP,C
Goto LOP
Else
Goto LOP
End If
End If
If YP>=YBASELINE(XP)
YBASELINE(XP)=YP
If FG=0
Goto LOP
End If
If F=0
Gosub MAG
Extension_12_036E XP,YP,C
F=1
End If
Gosub MAG
Extension_12_036E XP,YP,C
Goto LOP
End If
F=0
LOP:
Next XP
End If
OLDX=SX : OLDY=SY : Return
MAG:
If _TEST=0
C=Point(XP,YP)
If C=1 : C=2 : End If
Dec C
Else
C=1
End If
If C<0 : C=1 : End If
Return
End Proc
Procedure _COOLDOTS
Screen 0
Repeat
R1=Rnd(319)
R2=Rnd(255)
If _TEST=0
C=Point(R1,R2)
If C=1 : C=2 : End If
Dec C
Else
C=1
End If
If C<0 : C=1 : End If
Ink C
If _SELECTED=1
Extension_12_036E R1,R2,C
End If
If _SELECTED=2
Bar R1,R2 To R1+2,R2+2
End If
If _SELECTED=3
Draw R1,R2 To R1+2,R2+2
End If
If _SELECTED=4
R=Rnd(3)+1
If R=1
Circle R1,R2,Rnd(3)+1
End If
If R=2
Extension_12_036E R1,R2,C
End If
If R=3
Bar R1,R2 To R1+2,R2+2
End If
If R=4
Draw R1,R2 To R1+2,R2+2
End If
End If
Until Mouse Key
End Proc
Procedure _COOLTHINGS
Screen 0
XP=Rnd(625)+10 : YP=Rnd(250)+4
X=Rnd(625)+10 : Y=Rnd(250)+4
X2=Rnd(625)+10 : Y2=Rnd(250)+4
Repeat
_SS=_SELECTED
If _SELECTED=4
_SS=Rnd(6)+1
End If
_DIR=Rnd(3)+1
If _DIR=1 : Add XP,_SS : End If
If _DIR=2 : Add XP,-_SS : End If
If _DIR=3 : Add YP,_SS : End If
If _DIR=4 : Add YP,-_SS : End If
P1=Point(XP,YP)
If _TEST=0
Dec P1
If P1<=1 : P1=2 : End If
Else
P1=1
End If
If P1<0 : P1=1 : End If
Extension_12_036E XP,YP,P1
If XP<0 or XP>320 or YP<0 or YP>250
XP=Rnd(300)+10 : YP=Rnd(250)+4
End If
_DR=Rnd(3)+1
If _DR=1 : Add X,_SS : End If
If _DR=2 : Add X,-_SS : End If
If _DR=3 : Add Y,_SS : End If
If _DR=4 : Add Y,-_SS : End If
If _TEST=0
P1=Point(X,Y)
Dec P1
If P1<=1 : P1=2 : End If
Else
P1=1
End If
Extension_12_036E X,Y,P1
If X<0 or X>320 or Y<0 or Y>250
X=Rnd(300)+10 : Y=Rnd(250)+4
End If
_D=Rnd(3)+1
If _D=1 : Add X2,_SS : End If
If _D=2 : Add X2,-_SS : End If
If _D=3 : Add Y2,_SS : End If
If _D=4 : Add Y2,-_SS : End If
If _TEST=0
P1=Point(X2,Y2)
Dec P1
If P1<=1 : P1=2 : End If
Else
P1=1
End If
If P1<0 : P1=1 : End If
Extension_12_036E X2,Y2,P1
If X2<0 or X2>320 or Y2<0 or Y2>250
X2=Rnd(300)+10 : Y2=Rnd(250)+4
End If
Until Mouse Key
End Proc
Procedure _COOLTWISTER
Screen 0
HEIGHT=60
WIDTH=_SELECTED
If _SELECTED=4
WIDTH=Rnd(20)+3
End If
POSITION=128
SPEED=1
Degree
Repeat
Inc G
If G>3 : G=1 : End If
For SPRX=319 To -200 Step -SPEED
For K=0 To 200 Step 20
If G=1 : Y=Cos((SPRX+K)*WIDTH)*HEIGHT+POSITION : End If
If G=2 : Y=Sin((SPRX+K)*WIDTH)*HEIGHT+POSITION : End If
If G=3 : Y=Tan((SPRX+K)*WIDTH)*HEIGHT+POSITION : End If
If _TEST=0
C=Point(SPRX,Y)
If C<=1 : C=2 : End If
Dec C
Else
C=1
End If
Extension_12_036E SPRX,Y,C
If Mouse Key : Pop Proc : End If
Next K
Next SPRX
Add HEIGHT,-1
Until Mouse Key
End Proc
Procedure _COOLGRASS
Screen 0
NPS=100
For I=1 To NPS
X(I)=I*4
Y(I)=0
Next I
For J=0 To 75
Gr Locate X(1),Y(1)
For I=1 To NPS
If Mouse Key : Pop Proc : End If
R=Rnd(5)+1
Add Y(I),R
If _SELECTED=4
Ink Rnd(14)+1
Goto NOB
End If
P1=Point(X(I),Y(I))
If _TEST=0
Dec P1
If P1<=1 : P1=2 : End If
Else
P1=1
End If
If P1<0 : P1=1 : End If
Ink P1
NOB:
If _SELECTED=1 or _SELECTED=4
For A=1 To 5
Draw To X(I),Y(I)+A
Next A
End If
If _SELECTED=2
Plot X(I),Y(I)+A
End If
If _SELECTED=3
Draw 0,0 To X(I),Y(I)
End If
Next I
Next J
End Proc
Procedure _COOLSPIRAL
Screen 0
X=160
Y=128
SR=150
ER=_SELECTED
AB=1
VK=2
Degree
A=360/AB
L=SR
For S=0 To L
For W=0 To 359
If Mouse Key : Pop Proc : End If
If _SELECTED=1
P1=Point(X+SR*Cos(W),Y+SR*Sin(W))
End If
If _SELECTED=2
P1=Point(X+SR*Tan(W),Y+SR*Sin(W))
End If
If _SELECTED=3
P1=Point(X+SR*Sin(W),Y+SR*Cos(W))
End If
If _SELECTED=4
P1=Point(X+SR*Cos(W),Y+SR*Tan(W))
End If
If _TEST=0
Dec P1
If P1<=1 : P1=2 : End If
Else
P1=1
End If
If P1<0 : P1=1 : End If
If _SELECTED=1
Extension_12_036E X+SR*Cos(W),Y+SR*Sin(W),P1
End If
If _SELECTED=2
Extension_12_036E X+SR*Tan(W),Y+SR*Sin(W),P1
End If
If _SELECTED=3
Extension_12_036E X+SR*Sin(W),Y+SR*Cos(W),P1
End If
If _SELECTED=4
Extension_12_036E X+SR*Cos(W),Y+SR*Tan(W),P1
End If
K=W/A*A
If K=W Then SR=SR-1
If SR<=ER Then S=L
If VK=0 Then W=359
Next
Next
End Proc